home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 23 / CU Amiga - Super CD-ROM 23 (June 1998).iso / CreatingGames / Utilities / Asm / AB3DIIsrc / ams / ams.amosSourceCode
Encoding:
AMOS Source Code  |  1995-11-15  |  1.9 KB  |  127 lines
  1. Reserve As Work 15,320*256
  2. Dim C(31,31)
  3. Repeat 
  4. Screen Open 0,640,256,2,Hires
  5. Curs Off : Flash Off : Cls 0
  6. Colour 1,$FFF
  7. Dim R(255),G(255),B(255)
  8. F$=Fsel$("ab3:graphics/walls","","Load Wall Picture","")
  9. If F$="" Then End 
  10. Load Iff F$,1
  11.  
  12. Bload F$,Start(15)
  13.  
  14. S=Start(15)+94
  15. For A=0 To 31
  16. R(A)=Peek(S) : Add S,1
  17. G(A)=Peek(S) : Add S,1
  18. B(A)=Peek(S) : Add S,1
  19. Next 
  20.  
  21. End 
  22.  
  23. F$=F$-"ab3:graphics/walls/"
  24. Screen 0 : Screen To Front 0
  25. Input "Width of chunk: ";W
  26. Input "Height of chunk: ";H
  27. NOL=W/3
  28. NOL=NOL
  29. Screen 1 : Screen To Front 1
  30. X=0 : Y=0
  31. AP=Start(15)
  32.  
  33. For A=0 To 31
  34. C(A,0)=Colour(A) : Next 
  35. '
  36. For A=1 To 31
  37. V=32-A
  38. For Q=0 To 31
  39. LR=C(Q,A-1) and $F00
  40. LG=C(Q,A-1) and $F0
  41. LB=C(Q,A-1) and $F
  42. LR=LR/$100
  43. LG=LG/$10
  44.  
  45. R=C(Q,0) and $F00
  46. G=C(Q,0) and $F0
  47. B=C(Q,0) and $F
  48. R=R/$100 : G=G/$10
  49.  
  50. R=(R*V)/32
  51. G=(G*V)/32
  52. B=(B*V)/32
  53.  
  54. R=R and $F
  55. G=G and $F
  56. B=B and $F
  57.  
  58. D=Abs(LR-R)+Abs(LG-G)+Abs(LB-B)
  59. If D>500
  60.  If LG<>G and LB<>B and LR<>R
  61.    R=LR : G=LG
  62.  Else 
  63.    If LR<>R and LG<>G
  64.       R=LR
  65.    Else 
  66.       If LR<>R and LB<>B
  67.          R=LR
  68.       Else 
  69.          If LG<>G and LB<>B
  70.             G=LG
  71.          End If 
  72.       End If 
  73.    End If 
  74.  End If 
  75. End If 
  76.  
  77. C(Q,A)=R*$100+G*$10+B
  78.  
  79. Next 
  80. Next 
  81.  
  82. For A=0 To 31
  83. For B=0 To 31
  84. Doke AP,C(B,A)
  85. Add AP,2
  86. Next 
  87. Next 
  88.  
  89. D=AP
  90. X=0 : Y=0
  91. For L=0 To NOL
  92.    For V=0 To H-1
  93.       C= Extension_12_044C(X,Y+V)
  94.        Extension_12_036E X,Y+V,0
  95.       Doke D,C : Add D,2
  96.    Next 
  97.    Add X,3
  98.    If X>319 Then X=X-320 : Y=Y+H
  99. Next 
  100. D=AP
  101. X=1 : Y=0
  102. For L=0 To NOL
  103.    For V=0 To H-1
  104.       C= Extension_12_044C(X,Y+V)*32
  105.        Extension_12_036E X,Y+V,0
  106.       Doke D,C+Deek(D)
  107.       Add D,2
  108.    Next 
  109.    Add X,3
  110.    If X>319 Then X=X-320 : Y=Y+H
  111. Next 
  112. D=AP
  113. X=2 : Y=0
  114. For L=0 To NOL
  115.    For V=0 To H-1
  116.       C= Extension_12_044C(X,Y+V)*32*32
  117.        Extension_12_036E X,Y+V,0
  118.       Doke D,C+Deek(D)
  119.       Add D,2
  120.    Next 
  121.    Add X,3
  122.    If X>319 Then X=X-320 : Y=Y+H
  123. Next 
  124. F$=Fsel$("ab3:includes/Walls",F$,"Select Save Name","")
  125. If F$="" Then End 
  126. Bsave F$+".wad",Start(15) To D
  127. Until 0